home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / comp0_89.lha / Feel / Boot / Compiler / plists.em < prev    next >
Lisp/Scheme  |  1993-04-26  |  2KB  |  58 lines
  1.  
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;                                                                           ;;
  4. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  5. ;;                                                                           ;;
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7.  
  8. (defmodule plists (standard0) ()
  9.  
  10.   (deflocal main-table (make-table eq))
  11.  
  12.   (defun put (id key val)
  13.     (let ((prop-table (or 
  14.                 (table-ref main-table id)
  15.             (progn
  16.               ((setter table-ref) main-table id (make-table eq))
  17.               (table-ref main-table id)))))
  18.       ((setter table-ref) prop-table key val)
  19.       val))
  20.  
  21.   (export put)
  22.  
  23.   (defun get (id key)
  24.     (let ((tab (table-ref main-table id)))
  25.       (if tab (table-ref tab key) nil)))
  26.  
  27.   (export get)
  28.  
  29.   ((setter setter) get put)
  30.  
  31.   (defun remprop (id key)
  32.     (let ((tab (table-ref main-table id)))
  33.       (if (null tab) nil
  34.     (let ((ans (table-ref tab key)))
  35.                     ; May be a new table
  36.       ;;((setter table-ref) main-table id (table-delete tab key))
  37.       ans))))
  38.  
  39.   (export remprop)
  40.  
  41.   (defun symbol-props (id)
  42.     (let ((tab (table-ref main-table id)))
  43.       (if (null tab) nil
  44.     (let ((ans nil))
  45.       (map-table
  46.          (lambda (tag prop) (setq ans (cons tag (cons prop ans))))
  47.          tab)
  48.       ans))))
  49.  
  50.   (defun table-delete (t x)
  51.     ((setter table-ref) t x nil))
  52.  
  53.   (defun kill-props (id)
  54.     ((setter table-ref) main-table id nil))
  55.  
  56.   (export symbol-props kill-props)
  57. )
  58.